Shareware Grab Bag/Shareware Grab Bag.iso/002/pslabel.arc/PMLABEL.PAS

Pascal/Delphi Source File | 1986-11-08 | 5.2 KB | 166 lines

program PrintPM;  { print a graphic mailing labels }
   { All commands are for an Epson FX-185 printer }

{ Copyright (c) 1986   Clint Hastings - Salt Lake City, Utah }
{ Permission granted for all use of a non-commercial nature. }


type  CPUreg = record  case boolean of
                 false: (ax,bx,cx,dx,bp,si,di,ds,es,flags : integer);
                 true:  (al,ah,bl,bh,cl,ch,dl,dh          : byte)
               end;
     PMpic = record
               d1 : array[0..3] of byte;  { dummy info }
               p : array[0..51,0..10] of byte;
               d2 : byte;
             end;

{ the lines can be spaced to suit your needs but they aren't full-height
  lines, so don't use them all. These are the default lines - just hit
  <RETURN> instead of typing in new lines. }

const LabelLine : array[0..17] of string[40] =
                 ('',
                  '',
                  '         Clint & Nina Hastings',
                  '',
                  '',
                  '',
                  '          203 East 3rd Avenue',
                  '',
                  '',
                  '',
                  '           SLC, Utah  84103',
                  '',
                  '',
                  '',
                  '',
                  '',
                  '',
                  '');

var  reg : CPUreg;
     filename : string[80];
     screen : byte absolute $B800:0;
     g, n, Graphic, NumLabels,
     Col, Row, x, len1, len2 : integer;
     pf : file of PMpic;
     pic : PMpic;
     FileDrive, sameG : string[1];
     same : boolean;

procedure PrintPSGraphic(n : integer);
const BitMask : array[0..7] of byte =
           ($80, $40, $20, $10, 8, 4, 2, 1);

var  TempY : array[0..3] of byte;
     temp,b : byte;
     buf : array[0..127] of byte;
     BufPtr, step, y, x, p, i, j : integer;
     ch : char;

begin
  for y := 0 to 12 do BEGIN                { 52 rows @ 4 dots per row }
  if LabelLine[y] <> '' then
      write(lst,LabelLine[y],#13);
    write(lst,#27'L',chr(len1),chr(len2));
    for x := 0 to 10 do BEGIN
           for i := 0 to 3 do  { get next line }
              TempY[i] := pic.p[ y*4+i, x];
           for j := 0 to 7 do BEGIN
             temp := 0;
             for i := 0 to 3 do
               if (TempY[i] AND (1 shl (7-j)) ) <> 0 then
                   temp := temp + (1 shl (3-i));
             write(lst,chr(temp))
             END;
      END;
    writeln(lst)
    END;
  for y := 13 to 17 do BEGIN     { spacing for label }
      if LabelLine[y] <> '' then
          write(lst,LabelLine[y],#13);
    writeln(lst)
    END;
  if not same then read(pf,pic);
end;

procedure InfoScreen;
begin
  gotoxy(4,1);
  writeln('Copyright (c) 1986 - Clint Hastings - Salt Lake City, Utah');
  gotoxy(5,3);
  writeln('**********  PRINTMASTER  LABEL  MAKER  ****************');
  writeln;
  writeln('    This program lets you print mailing labels using');
  writeln('    PrintMaster graphics for decoration. You can print');
  writeln('    as many labels as you want. The graphic can be the');
  writeln('    same on each label, or can move sequentially through');
  writeln('    the graphic file starting at a given graphic. It can');
  writeln('    use the default graphic files - hit <RETURN> in response');
  writeln('    to graphic file?. You can use the Art Gallery by typing');
  writeln('    U or S. Graphic file drive - type A,B,C, etc., but no');
  writeln('    colon is necessary.    Have fun!!!');
  writeln('NOTE:');
  writeln('    Printer codes are for Epson FX printers. Source code');
  writeln('    in Turbo Pascal is provided for you to make necessary');
  writeln('    changes for other printers. Set NLQ beforehand if you');
  writeln('    want the address lines to be in NLQ.');
  writeln;
  writeln
end;

procedure Setup;
var  line : string[40];
begin
  write(lst,#27'A'#4);     { 4 dots vertical - line spacing }
  len1 := (11*8) mod 256;  { calculate number of dots per line }
  len2 := (11*8) div 256;

  InfoScreen;
  writeln;
  writeln('    PRINTMASTER LABEL MAKER');
  write(#13#10'    Number of Labels to print ? ');
  readln(NumLabels);
  write(#13#10'    Graphic to print ? ');
  readln(Graphic);
  Graphic := Graphic - 1;
  write(#13#10'    Graphic file (U,S) ? ');
  readln(FileName);
  write(#13#10'    Graphic file drive ? ');
  readln(FileDrive);
  if FileName = '' then  FileName := FileDrive + ':slib.shp'
                   else  FileName := FileDrive + ':' + FileName + 'lib.shp';

  assign(pf,FileName);
  {$I-}  reset(pf);  {$I+}
  if IOresult <> 0 then HALT;

  seek(pf,Graphic);
  read(pf,pic);

  writeln(#13#10'3 label lines :');
  readln(line);
  if line <> '' then BEGIN
      LabelLine[2] := '         ' + line;
      readln(line);
      LabelLine[6] := '         ' + line;
      readln(line);
      LabelLine[10] := '         ' + line;
      END;
  write(#13#10'All the same graphic (y/n) ? ');
  readln(sameG);
  same := (sameG <> 'n') and (sameG <> 'N');
end;

begin
  ClrScr;
  Setup;

  for n := Graphic to Graphic-1+NumLabels do  PrintPSGraphic(n);

  close(pf);
  write(lst,#27'2');  { restore regular line spacing }
end.